home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / adynware / utility_file.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  6.1 KB  |  231 lines
  1. package utility_file;
  2. #use strict;
  3. use IO::File;
  4.  
  5. #=================================================================================
  6. my %utility__diskSizes = ();
  7. my %utility__blockSizes = ();
  8. my %utility__diskSpaceAvailable = ();
  9.  
  10. sub sniffDisk
  11. {
  12.         my($disk) = @_;
  13.         
  14.         # does not work: why not?
  15.         #my $process = new IO::File("c:/perl/bin/spinach.exe -o c:/perl/disk.$disk -disk $disk |") or die "utility_file::sniffDisk could not execute process";
  16.         #open(PROCESS, "c:/perl/bin/spinach.exe -o c:/perl/disk.$disk -disk $disk |") or die "utility_file::sniffDisk could not execute process";
  17.         #my $processOutput = getContentHandle(PROCESS);
  18.         #print "read ' $processOutput' from process\n";
  19.         #$process->close();
  20.         #
  21.         # the following works, but results in a dos window appearing while the program runs.
  22.         # I believe this window corresponds to cmd.exe.  This happens even if the spawning
  23.         # process is detached.
  24.         # system("c:\\perl\\bin\\setup.exe -o c:/perl/disk.dat -disk $disk");
  25.        
  26.         my $output = getContent("c:/perl/disk.$disk");
  27.         unlink("c:/perl/disk.$disk");
  28.         
  29.         if ($output !~ /block size=(\d+).*disk size=(\d+).*free space=(\d+)/s)
  30.         {
  31.                 print "sniffDisk got bad output: '$output'\n";
  32.                 print "sniffDisk just guessing...\n";
  33.                                 
  34.                 $utility__blockSizes{$disk} = 1024;
  35.                 $utility__diskSizes{$disk} = 10000000;
  36.                 $utility__diskSpaceAvailable{$disk} = 10000000;
  37.         }
  38.         else
  39.         {
  40.                 $utility__blockSizes{$disk} = $1;
  41.                 $utility__diskSizes{$disk} = $2;
  42.                 $utility__diskSpaceAvailable{$disk} = $3;
  43.                 print "sniffDisk($disk) saw block size $1, disk size $2, available $3\n";
  44.         }
  45. }
  46.  
  47.  
  48. sub RoundFileLength
  49. {
  50.         my($blockSize, $length) = @_;
  51.         return $length unless $length % $blockSize;
  52.         return (int($length/$blockSize) + 1) * $blockSize;
  53. }
  54. sub availableStorage
  55. {
  56.         my($disk) = @_;
  57.                 
  58.         sniffDisk($disk) unless $utility__diskSpaceAvailable{$disk};
  59.         return $utility__diskSpaceAvailable{$disk};
  60. }
  61.  
  62. sub blockSize
  63. {
  64.         my($disk) = @_;
  65.                 
  66.         sniffDisk($disk) unless defined $utility__blockSizes{$disk};
  67.         return $utility__blockSizes{$disk};
  68. }
  69. #=================================================================================
  70.  
  71.  
  72.  
  73.  
  74. sub mv
  75. {
  76.         my($oldName, $newName) = @_;
  77.         unlink($oldName);
  78.         rename($oldName, $newName) or die "mv $oldName $newName failed:$!";
  79. }
  80.  
  81. sub getContent
  82. {
  83.         my($fileName) = @_;
  84.         $fileName = substr($fileName, 0, 255) if (length($fileName) >= 255);
  85.         
  86.         my $file = new IO::File("< $fileName") or return "";
  87.         my $content = getContentHandle($file);
  88.         close $file;
  89.         return $content;
  90. }
  91.  
  92.  
  93. sub setContent
  94. {
  95.         my($fileName, $content) = @_;
  96.         $fileName = substr($fileName, 0, 255) if (length($fileName) >= 255);
  97.         
  98.         my $file = new IO::File("> $fileName") or die "utility_file::setContent could not open $fileName";
  99.         binmode $file;
  100.         #print "-------------------------------------utility_file::setContent($fileName)\n";
  101.         print $file $content;
  102.         close $file;
  103. }
  104.  
  105. sub directoryDepth
  106. {
  107.         my($fileName) = @_;
  108.                 
  109.         $fileName = $1 if $fileName =~ m{^\./(.*)}; 
  110.         
  111.         my $j;
  112.         for ($j = 0; $fileName =~ m{/}g; $j++)
  113.         {
  114.                 ;
  115.         }
  116.         return $j;
  117. }
  118.  
  119. sub getContentHandle
  120. {
  121.         my($file) = @_;
  122.  
  123.         binmode $file;
  124.         my $contents = "";
  125.         for (;;)
  126.         {
  127.                 my $buffer;
  128.                 my $n = read($file, $buffer, 9184);
  129.                 die "getContentHandle: error reading $file:$!" if $n < 0;
  130.                 last if $n==0;
  131.                 $contents .= $buffer;
  132.         }
  133.         return $contents;
  134. }
  135.  
  136. sub cat
  137. {
  138.         my($file1, $file2) = @_;
  139.  
  140.         binmode $file1;
  141.         binmode $file2;
  142.         my $buffer;
  143.         for (;;)
  144.         {
  145.                 my $n = read($file1, $buffer, 9184);
  146.                 die "error in cat:$!" if $n < 0;
  147.                 last if $n==0;
  148.                 if (defined $file2)
  149.                 {
  150.                         print $file2 $buffer;
  151.                 }
  152.                 else
  153.                 {
  154.                         print STDERR $buffer;                        
  155.                 }
  156.         }
  157. }
  158.  
  159.  
  160. sub flattenURL
  161. {
  162.         my($name) = @_;
  163.         $name = tameURL($name);
  164.         $name =~ s{/}{_}g;
  165.         return $name;
  166. }
  167.  
  168. sub tameURL
  169. {
  170.         my($name) = @_;
  171.         die "tameURL got undefined" unless defined $name;
  172.         $name =~ s{^http://}{};
  173.         $name =~ s{[^\d\w/\._-]}{_}g;
  174.         $name =~ s{/+}{/}g;
  175.         $name =~ s{/$}{_};
  176.         return $name;
  177. }
  178.  
  179. sub basename
  180. {
  181.         my($name) = @_;
  182.         return "" if $name =~ m{^https?://[^/]+(/~\w+)?$};    # no file specified; leading URL root
  183.         return "" if $name =~ m{^https?://.*/$};        # no file specified; trailing /
  184.         return $1 if ($name =~ m{/([^/]*)$});            # normal case
  185.         return "";
  186. }
  187. sub dirname
  188. {
  189.         my($name) = @_;
  190.         return $1 if $name =~ m{^(https?://[^/]+(/~\w+)?)/?$};    # no file specified
  191.         return $1 if $name =~ m{^(https?://.*)/$};        # no file specified; trailing /
  192.         return $name if $name =~ m{\w+://[^/]+$};        # internet protocol with host only
  193.         return $1    if $name =~ m{(.+)/[^/]*$};        # normal case
  194.         return ".";
  195. }
  196.  
  197. sub mkdirP
  198. {
  199.         my($dir) = @_;
  200.         return 1 if -d $dir;
  201.         return 0 unless mkdirP(dirname($dir));
  202.         return mkdir($dir, '777');
  203. }
  204.  
  205. sub stripAnchor
  206. {
  207.         my($page) = @_;
  208.         
  209.         my $pageWithoutAnchor;
  210.         if ($page =~ /(.*)#.*/)
  211.         {
  212.                 $pageWithoutAnchor = $1;
  213.         }
  214.         else
  215.         {
  216.                 $pageWithoutAnchor = $page;
  217.         }
  218.         return $pageWithoutAnchor;
  219. }
  220.                                         
  221. sub isHtml
  222. {
  223.         my($fileName) = @_;
  224.         return ($fileName =~ m{(\.s?html?|/)$}i);
  225. }
  226.  
  227. 1;
  228.  
  229. #sniffDisk("c");
  230. ## test with: perl -w c:/perl/lib/utility_file.pm
  231.